home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / libs / svgapb23 / svgamod1.bas < prev    next >
BASIC Source File  |  1995-01-19  |  39KB  |  1,345 lines

  1. '****************************************************************************
  2. '*
  3. '*      'SVGAPB' A Super VGA Graphics Librarys for use with
  4. '*      Power Basic Inc's Power BASIC 3.00c and later
  5. '*      Copyright 1993-1995 by Stephen L. Balkum and Daniel A. Sill
  6. '*
  7. '*      Power BASIC is a registered trademark of Power BASIC Inc.
  8. '*
  9. '*    **************** UNREGISTERED SHAREWARE VERSION **********************
  10. '*    * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN  *
  11. '*    * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
  12. '*    * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
  13. '*    **********************************************************************
  14. '*
  15. '*    **************** NO WARRANTIES AND NO LIABILITY **********************
  16. '*    * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
  17. '*    * expressed or implied, of merchant ability, or fitness, for a       *
  18. '*    * particular use or purpose of this SOFTWARE and documentation.      *
  19. '*    * In no event shall Stephen L. Balkum or Daniel A. Sill be held      *
  20. '*    * liable for any damages resulting from the use or misuse of the     *
  21. '*    * SOFTWARE and documentation.                                        *
  22. '*    **********************************************************************
  23. '*
  24. '*    ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
  25. '*    * Use, duplication, or disclosure of the SOFTWARE and documentation  *
  26. '*    * by the U.S. Government is subject to the restrictions as set forth *
  27. '*    * in subparagraph (c)(1)(ii) of the Rights in Technical Data and     *
  28. '*    * Computer Software clause at DFARS 252.227-7013.                    *
  29. '*    * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill,   *
  30. '*    * P.O. Box 7704, Austin, Texas 78713-7704                            *
  31. '*    **********************************************************************
  32. '*
  33. '*    **********************************************************************
  34. '*    * By using this SOFTWARE or documentation, you agree to the above    *
  35. '*    * terms and conditions.                                              *
  36. '*    **********************************************************************
  37. '*
  38. '****************************************************************************
  39.  
  40.  
  41.   $INCLUDE "SVGAPB.BI"
  42.   $INCLUDE "SVGADEMO.BI"
  43.  
  44.     DEFINT A-Z
  45.  
  46.     SUB DOBLOCK (RET$)
  47.     
  48.     MYPI! = ATN(1) * 4
  49.  
  50.     '*************************************************************************
  51.     '* SET UP THE TITLE
  52.     '*************************************************************************
  53.     TITLE$ = "DEMO 5: Block functions and Sprites"
  54.     PALSET PAL(0), 0, 255
  55.  
  56.     '*************************************************************************
  57.     '* SHOW BLOCK GET (DRAW SOME CIRCLES AND "GET A CHUNK OF THEM")
  58.     '*************************************************************************
  59.     FILLSCREEN 0
  60.     SETVIEW 0, 0, GETMAXX, GETMAXY
  61.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  62.     A$ = "BLKGET (X1,Y1,X2,Y2,GfxBlock)"
  63.     DRWSTRING 1, 7, 0, A$, 10, 16
  64.     Colr = 16
  65.     FOR I = 0 TO GETMAXX \ 2
  66.         DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
  67.         Colr = Colr + 4
  68.         IF Colr > 255 THEN
  69.             Colr = 16
  70.         END IF
  71.     NEXT I
  72.     XINC = GETMAXX \ 20
  73.     YINC = GETMAXY \ 20
  74.     X1 = GETMAXX \ 2 - XINC
  75.     Y1 = GETMAXY \ 2 - YINC
  76.     X2 = GETMAXX \ 2 + XINC
  77.     Y2 = GETMAXY \ 2 + YINC
  78.     DRWBOX 1, 0, X1, Y1, X2, Y2
  79.     BLKSIZE1 = (((X2 - X1 + 1) * (Y2 - Y1 + 1)) / 2) + 3
  80.   REDIM DYNAMIC GFXBLK1(BLKSIZE1) AS SHARED INTEGER
  81.     BLKGET X1, Y1, X2, Y2, GFXBLK1(0)
  82.     GETKEY RET$
  83.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  84.         FILLSCREEN 0
  85.         EXIT SUB
  86.     END IF
  87.  
  88.     '*************************************************************************
  89.     '* SHOW BLOCK ROTATE AND SPRITE STUFF
  90.     '*************************************************************************
  91.     X = (X2 - X1) \ 2 + X1
  92.     Y = (Y2 - Y1) \ 2 + Y1
  93.     A$ = "BLKROTATE (Angle,BackFill,SourceGfxBlock,DestGfxBlock)   "
  94.     DRWSTRING 1, 7, 0, A$, 10, 16
  95.     A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundGfxBlock)"
  96.     DRWSTRING 1, 7, 0, A$, 10, 32
  97.     A$ = "SPRITEPUT(Mode%,TranSColr,X,Y,SpriteArray)"
  98.     DRWSTRING 1, 7, 0, A$, 10, 48
  99.     FILLAREA X1 + 2, Y1 + 2, 0, 0
  100.     BLKSIZE2 = (BLKROTATESIZE(45, GFXBLK1(0)) \ 2) + 1
  101.   REDIM DYNAMIC GFXBLK2(BLKSIZE2) AS SHARED INTEGER
  102.   REDIM DYNAMIC GFXBLK3(BLKSIZE2) AS SHARED INTEGER
  103.     BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
  104.     SETVIEW 0, 64, GETMAXX, GETMAXY
  105.     FOR I = 0 TO 360 STEP 3
  106.         DUMMY = BLKROTATE(I, 1, GFXBLK1(0), GFXBLK2(0))
  107.         SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
  108.         SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
  109.         SDELAY 4
  110.     NEXT I
  111.     SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
  112.     BLKPUT 1, X1, Y1, GFXBLK1(0)
  113.     GETKEY RET$
  114.     SETVIEW 0, 0, GETMAXX, GETMAXY
  115.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  116.         FILLSCREEN 0
  117.         EXIT SUB
  118.     END IF
  119.  
  120.     '*************************************************************************
  121.     '* SHOW BLOCK RESIZE AND SPRITE STUFF
  122.     '*************************************************************************
  123.     A$ = "BLKRESIZE (NewWidth,NewHeight,SourceGfxBlock,DestGfxBlock)   "
  124.     DRWSTRING 1, 7, 0, A$, 10, 16
  125.     A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundGfxBlock)"
  126.     DRWSTRING 1, 7, 0, A$, 10, 32
  127.     A$ = "SPRITEPUT(Mode%,TranSColr,X,Y,SpriteArray)"
  128.     DRWSTRING 1, 7, 0, A$, 10, 48
  129.     SETVIEW 0, 64, GETMAXX, GETMAXY
  130.     FILLAREA X1 + 2, Y1 + 2, 0, 0
  131.     BLKSIZE3 = (((X2 - X1 + 1) * (Y2 - Y1 + 1)) / 2) + 3
  132.   REDIM DYNAMIC GFXBLK3(BLKSIZE3) AS SHARED INTEGER
  133.     BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
  134.     BLKSIZE2 = (((GFXBLK1(0) + 1) * (GFXBLK1(1) + 1)) / 2) + 3
  135.   REDIM DYNAMIC GFXBLK2(BLKSIZE2) AS SHARED INTEGER
  136.     FOR I = 0 TO XINC
  137.         BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
  138.         SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
  139.         SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
  140.         SDELAY 5
  141.     NEXT I
  142.     SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
  143.     FOR I = XINC TO 0 STEP -1
  144.         BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
  145.         SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
  146.         SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
  147.         SDELAY 5
  148.     NEXT I
  149.     SPRITEPUT 1, 1, X - GFXBLK1(0) \ 2, Y - GFXBLK1(1) \ 2, GFXBLK1(0)
  150.     GETKEY RET$
  151.     SETVIEW 0, 0, GETMAXX, GETMAXY
  152.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  153.         FILLSCREEN 0
  154.         EXIT SUB
  155.     END IF
  156.  
  157.     '*************************************************************************
  158.     '* SHOW BLOCK PUT (PUT THE "CHUNKS" RANDOMLY AROUND THE SCREEN)
  159.     '*************************************************************************
  160.     SETVIEW 0, 31, GETMAXX, 64
  161.     FILLVIEW 0
  162.     A$ = "BLKPUT (Mode,X,Y,GfxBlock)   "
  163.     DRWSTRING 1, 7, 0, A$, 10, 16
  164.     XINC = GETMAXX \ 10
  165.     YINC = GETMAXY \ 10
  166.     SETVIEW 0, 32, GETMAXX, GETMAXY
  167.     FOR I = 0 TO GETMAXX \ 2
  168.         X = (GETMAXX + XINC) * RND - XINC
  169.         Y = (GETMAXY + YINC) * RND - YINC
  170.         BLKPUT 1, X, Y, GFXBLK1(0)
  171.     NEXT I
  172.     GETKEY RET$
  173.     SETVIEW 0, 0, GETMAXX, GETMAXY
  174.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  175.         FILLSCREEN 0
  176.         EXIT SUB
  177.     END IF
  178.  
  179.     END SUB
  180.  
  181.     SUB DOCLIP (RET$)
  182.     
  183.     '*************************************************************************
  184.     '* SET UP AND SHOW THE TITLE
  185.     '*************************************************************************
  186.     TITLE$ = "DEMO 2: Clipping capability"
  187.     PALSET PAL2(0), 0, 255
  188.  
  189.     '*************************************************************************
  190.     '* SET UP THE WINDOWS
  191.     '*************************************************************************
  192.     FILLSCREEN 0
  193.     SETVIEW 0, 0, GETMAXX, GETMAXY
  194.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  195.     A$ = "All primitives automatically clip"
  196.     DRWSTRING 1, 7, 0, A$, 10, 16
  197.     WDTH = (GETMAXX + 1) / 2.25
  198.     SPCINGX = ((GETMAXX + 1) - WDTH * 2) / 3
  199.     HGTH = (GETMAXY + 1 - 35) / 2.25
  200.     SPCINGY = ((GETMAXY + 1 - 35) - HGTH * 2) / 3
  201.     XINC = WDTH * 1.5
  202.     YINC = HGTH * 1.5
  203.     XSUB = WDTH * .25
  204.     YSUB = HGTH * .25
  205.     B1X1 = SPCINGX
  206.     B1X2 = B1X1 + WDTH
  207.     B1Y1 = SPCINGY + 35
  208.     B1Y2 = B1Y1 + HGTH
  209.     B2X2 = GETMAXX - SPCINGX
  210.     B2X1 = B2X2 - WDTH
  211.     B2Y1 = SPCINGY + 35
  212.     B2Y2 = B2Y1 + HGTH
  213.     B3X2 = GETMAXX - SPCINGX
  214.     B3X1 = B3X2 - WDTH
  215.     B3Y2 = GETMAXY - SPCINGY
  216.     B3Y1 = B3Y2 - HGTH
  217.     B4X1 = SPCINGX
  218.     B4X2 = B4X1 + WDTH
  219.     B4Y2 = GETMAXY - SPCINGY
  220.     B4Y1 = B4Y2 - HGTH
  221.     DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
  222.     DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
  223.     DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
  224.     DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2
  225.     B1X1 = B1X1 + 1
  226.     B1Y1 = B1Y1 + 1
  227.     B1X2 = B1X2 - 1
  228.     B1Y2 = B1Y2 - 1
  229.     B2X1 = B2X1 + 1
  230.     B2Y1 = B2Y1 + 1
  231.     B2X2 = B2X2 - 1
  232.     B2Y2 = B2Y2 - 1
  233.     B3X1 = B3X1 + 1
  234.     B3Y1 = B3Y1 + 1
  235.     B3X2 = B3X2 - 1
  236.     B3Y2 = B3Y2 - 1
  237.     B4X1 = B4X1 + 1
  238.     B4Y1 = B4Y1 + 1
  239.     B4X2 = B4X2 - 1
  240.     B4Y2 = B4Y2 - 1
  241.     Colr = 1
  242.     
  243.     '*************************************************************************
  244.     '* SHOW THE CLIPPING
  245.     '*************************************************************************
  246.     FOR I = 0 TO GETMAXX \ 6
  247.         FOR J = 1 TO 4
  248.             SELECT CASE J
  249.                 CASE = 1
  250.                     SETVIEW B1X1, B1Y1, B1X2, B1Y2
  251.                     FOR K = 0 TO 4
  252.                         X = B1X1 + RND * XINC - XSUB
  253.                         Y = B1Y1 + RND * XINC - XSUB
  254.                         DRWPOINT 1, Colr, X, Y
  255.                         Colr = Colr + 1
  256.                         IF Colr > 15 THEN
  257.                             Colr = 1
  258.                         END IF
  259.                     NEXT K
  260.                 CASE = 2
  261.                     SETVIEW B2X1, B2Y1, B2X2, B2Y2
  262.                     X1 = B2X1 + RND * XINC - XSUB
  263.                     Y1 = B2Y1 + RND * XINC - XSUB
  264.                     X2 = B2X1 + RND * XINC - XSUB
  265.                     Y2 = B2Y1 + RND * XINC - XSUB
  266.                     DRWLINE 1, Colr, X1, Y1, X2, Y2
  267.                     Colr = Colr + 1
  268.                     IF Colr > 15 THEN
  269.                         Colr = 1
  270.                     END IF
  271.                 CASE = 3
  272.                     SETVIEW B3X1, B3Y1, B3X2, B3Y2
  273.                     X = B3X1 + RND * XINC - XSUB
  274.                     Y = B3Y1 + RND * XINC - XSUB
  275.                     RAD = RND * WDTH \ 2
  276.                     DRWCIRCLE 1, Colr, X, Y, RAD
  277.                     Colr = Colr + 1
  278.                     IF Colr > 15 THEN
  279.                         Colr = 1
  280.                     END IF
  281.                 CASE = 4
  282.                     SETVIEW B4X1, B4Y1, B4X2, B4Y2
  283.                     X = B4X1 + RND * XINC - XSUB
  284.                     Y = B4Y1 + RND * XINC - XSUB
  285.                     RADX = RND * WDTH \ 2
  286.                     RADY = RND * WDTH \ 2
  287.                     DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  288.                     Colr = Colr + 1
  289.                     IF Colr > 15 THEN
  290.                         Colr = 1
  291.                     END IF
  292.             END SELECT
  293.         NEXT J
  294.     NEXT I
  295.     SETVIEW 0, 0, GETMAXX, GETMAXY
  296.     GETKEY RET$
  297.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  298.         EXIT SUB
  299.     END IF
  300.     END SUB
  301.  
  302.     SUB DOFILL (RET$)
  303.     
  304.     '*************************************************************************
  305.     '* SET UP THE TITLE
  306.     '*************************************************************************
  307.     TITLE$ = "DEMO 3: Filling functions"
  308.     PALSET PAL(0), 0, 255
  309.     
  310.     '*************************************************************************
  311.     '* SHOW SCREEN FILL
  312.     '*************************************************************************
  313.     FILLSCREEN 10
  314.     SETVIEW 0, 0, GETMAXX, GETMAXY
  315.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  316.     A$ = "FILLSCREEN (Color)"
  317.     DRWSTRING 1, 7, 0, A$, 10, 16
  318.     GETKEY RET$
  319.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  320.         SETVIEW 0, 0, GETMAXX, GETMAXY
  321.         EXIT SUB
  322.     END IF
  323.     
  324.     '*************************************************************************
  325.     '* SET UP WINDOWS AND SHOW VIEWPORT FILL
  326.     '*************************************************************************
  327.     FILLSCREEN 0
  328.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  329.     A$ = "FILLVIEW (Color)"
  330.     DRWSTRING 1, 7, 0, A$, 10, 16
  331.     WDTH = (GETMAXX + 1) / 2.25
  332.     SPCINGX = ((GETMAXX + 1) - WDTH * 2) / 3
  333.     HGTH = (GETMAXY + 1 - 35) / 2.25
  334.     SPCINGY = ((GETMAXY + 1 - 35) - HGTH * 2) / 3
  335.     XINC = WDTH * 1.5
  336.     YINC = HGTH * 1.5
  337.     XSUB = WDTH * .25
  338.     YSUB = HGTH * .25
  339.     B1X1 = SPCINGX
  340.     B1X2 = B1X1 + WDTH
  341.     B1Y1 = SPCINGY + 35
  342.     B1Y2 = B1Y1 + HGTH
  343.     B2X2 = GETMAXX - SPCINGX
  344.     B2X1 = B2X2 - WDTH
  345.     B2Y1 = SPCINGY + 35
  346.     B2Y2 = B2Y1 + HGTH
  347.     B3X2 = GETMAXX - SPCINGX
  348.     B3X1 = B3X2 - WDTH
  349.     B3Y2 = GETMAXY - SPCINGY
  350.     B3Y1 = B3Y2 - HGTH
  351.     B4X1 = SPCINGX
  352.     B4X2 = B4X1 + WDTH
  353.     B4Y2 = GETMAXY - SPCINGY
  354.     B4Y1 = B4Y2 - HGTH
  355.     DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
  356.     DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
  357.     DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
  358.     DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2
  359.     B1X1 = B1X1 + 1
  360.     B1Y1 = B1Y1 + 1
  361.     B1X2 = B1X2 - 1
  362.     B1Y2 = B1Y2 - 1
  363.     B2X1 = B2X1 + 1
  364.     B2Y1 = B2Y1 + 1
  365.     B2X2 = B2X2 - 1
  366.     B2Y2 = B2Y2 - 1
  367.     B3X1 = B3X1 + 1
  368.     B3Y1 = B3Y1 + 1
  369.     B3X2 = B3X2 - 1
  370.     B3Y2 = B3Y2 - 1
  371.     B4X1 = B4X1 + 1
  372.     B4Y1 = B4Y1 + 1
  373.     B4X2 = B4X2 - 1
  374.     B4Y2 = B4Y2 - 1
  375.     GETKEY RET$
  376.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  377.         SETVIEW 0, 0, GETMAXX, GETMAXY
  378.         EXIT SUB
  379.     END IF
  380.     SETVIEW B1X1, B1Y1, B1X2, B1Y2
  381.     FILLVIEW 10
  382.     SETVIEW B2X1, B2Y1, B2X2, B2Y2
  383.     FILLVIEW 12
  384.     SETVIEW B3X1, B3Y1, B3X2, B3Y2
  385.     FILLVIEW 13
  386.     SETVIEW B4X1, B4Y1, B4X2, B4Y2
  387.     FILLVIEW 14
  388.     SETVIEW 0, 0, GETMAXX, GETMAXY
  389.     GETKEY RET$
  390.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  391.         SETVIEW 0, 0, GETMAXX, GETMAXY
  392.         EXIT SUB
  393.     END IF
  394.     
  395.     '*************************************************************************
  396.     '* SET UP WINDOW AND SHOW AREA FILL
  397.     '*************************************************************************
  398.     FILLSCREEN 0
  399.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  400.     A$ = "FILLAREA (Xseed,Yseed,BrdrCol,FilCol)"
  401.     DRWSTRING 1, 7, 0, A$, 10, 16
  402.     DRWBOX 1, 15, 5, 35, GETMAXX - 4, GETMAXY - 4
  403.     SETVIEW 6, 36, GETMAXX - 5, GETMAXY - 5
  404.  
  405.     Colr = 1
  406.     FOR I = 0 TO GETMAXX \ 10
  407.         X = 50 + RND * (GETMAXX - 50)
  408.         Y = 50 + RND * (GETMAXY - 50)
  409.         RADX = 2 + RND * GETMAXX \ 20
  410.         RADY = 2 + RND * GETMAXX \ 20
  411.         DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  412.         Colr = Colr + 1
  413.         IF Colr > 9 THEN
  414.             Colr = 1
  415.         END IF
  416.     NEXT I
  417.     FOR I = 0 TO GETMAXX \ 15
  418.         X = 50 + RND * (GETMAXX - 50)
  419.         Y = 50 + RND * (GETMAXY - 50)
  420.         RADX = 2 + RND * GETMAXX \ 20
  421.         RADY = 2 + RND * GETMAXX \ 20
  422.         DRWELLIPSE 1, 12, X, Y, RADX, RADY
  423.     NEXT I
  424.     GETKEY RET$
  425.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  426.         SETVIEW 0, 0, GETMAXX, GETMAXY
  427.         EXIT SUB
  428.     END IF
  429.     FILLAREA 7, 37, 12, 10
  430.     GETKEY RET$
  431.     SETVIEW 0, 0, GETMAXX, GETMAXY
  432.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  433.         EXIT SUB
  434.     END IF
  435.     
  436.     '*************************************************************************
  437.     '* SET UP WINDOW AND SHOW COLOR FILL
  438.     '*************************************************************************
  439.     FILLSCREEN 0
  440.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  441.     A$ = "FILLCOLOR (Xseed,Yseed,OldCol,FilCol)"
  442.     DRWSTRING 1, 7, 0, A$, 10, 16
  443.     DRWBOX 1, 15, 5, 35, GETMAXX - 4, GETMAXY - 4
  444.     SETVIEW 6, 36, GETMAXX - 5, GETMAXY - 5
  445.     Colr = 1
  446.     FOR I = 0 TO GETMAXX \ 10
  447.         X = 50 + RND * (GETMAXX - 50)
  448.         Y = 50 + RND * (GETMAXY - 50)
  449.         RADX = 2 + RND * GETMAXX \ 20
  450.         RADY = 2 + RND * GETMAXX \ 20
  451.         DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  452.         Colr = Colr + 1
  453.         IF Colr > 9 THEN
  454.             Colr = 1
  455.         END IF
  456.     NEXT I
  457.     FOR I = 0 TO GETMAXX \ 15
  458.         X = 50 + RND * (GETMAXX - 50)
  459.         Y = 50 + RND * (GETMAXY - 50)
  460.         RADX = 2 + RND * GETMAXX \ 20
  461.         RADY = 2 + RND * GETMAXX \ 20
  462.         DRWELLIPSE 1, 12, X, Y, RADX, RADY
  463.     NEXT I
  464.     GETKEY RET$
  465.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  466.         SETVIEW 0, 0, GETMAXX, GETMAXY
  467.         EXIT SUB
  468.     END IF
  469.     FILLCOLOR 7, 37, 0, 10
  470.     SETVIEW 0, 0, GETMAXX, GETMAXY
  471.     GETKEY RET$
  472.     END SUB
  473.  
  474.     SUB DOPAL (RET$)
  475.     
  476.     '*************************************************************************
  477.     '* SET UP THE TITLE
  478.     '*************************************************************************
  479.     TITLE$ = "DEMO 4: Palette functions"
  480.     PALSET ORGPAL(0), 0, 255
  481.     
  482.     '*************************************************************************
  483.     '* SHOW PALETTE SET/GET
  484.     '*************************************************************************
  485.     FILLSCREEN 0
  486.     SETVIEW 0, 0, GETMAXX, GETMAXY
  487.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  488.     A$ = "PALGET (Palette,FirstColr,LastColr) PALSET (Palette,FirtColr,LastColr)"
  489.     DRWSTRING 1, 7, 0, A$, 10, 16
  490.     Colr = 16
  491.     X1 = 10
  492.     X2 = GETMAXX - 9
  493.     Y1 = 35
  494.     Y2 = GETMAXY - 9
  495.     I = 0
  496.     WHILE Y1 + I < Y2 - I
  497.         DRWBOX 1, Colr, X1 + I, Y1 + I, X2 - I, Y2 - I
  498.         Colr = Colr + 1
  499.         IF Colr > 255 THEN
  500.             Colr = 16
  501.         END IF
  502.         I = I + 1
  503.     WEND
  504.     GETKEY RET$
  505.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  506.         FILLSCREEN 0
  507.         PALSET PAL(0), 16, 255
  508.         SETVIEW 0, 0, GETMAXX, GETMAXY
  509.         EXIT SUB
  510.     END IF
  511.     PALSET PAL(0), 16, 255
  512.     
  513.     '*************************************************************************
  514.     '* SHOW PALETTE AUTO FADE OUT/IN
  515.     '*************************************************************************
  516.     A$ = "PALIOAUTO (Palette,FirstColr,LastColr,Speed)                           "
  517.     DRWSTRING 1, 7, 0, A$, 10, 16
  518.     GETKEY RET$
  519.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  520.         SETVIEW 0, 0, GETMAXX, GETMAXY
  521.         EXIT SUB
  522.     END IF
  523.     PALIOAUTO PAL(0), 16, 255, -2
  524.     PALIOAUTO PAL(0), 16, 255, 2
  525.  
  526.     '*************************************************************************
  527.     '* SHOW PALETTE AUTO FADE TO
  528.     '*************************************************************************
  529.     A$ = "PALCHGAUTO (Palette,NewPalette$,FirstColr,LastColr,Speed)"
  530.     DRWSTRING 1, 7, 0, A$, 10, 16
  531.     GETKEY RET$
  532.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  533.         SETVIEW 0, 0, GETMAXX, GETMAXY
  534.         EXIT SUB
  535.     END IF
  536.     PALCHGAUTO PAL(0), PAL2(0), 16, 255, 2
  537.     PALCHGAUTO PAL2(0), PAL(0), 16, 255, 2
  538.  
  539.     '*************************************************************************
  540.     '* SHOW PALETTE ROTATE
  541.     '*************************************************************************
  542.     A$ = "PALROTATE (Palette,FirstColr,LastColr,Shift)             "
  543.     DRWSTRING 1, 7, 0, A$, 10, 16
  544.     GETKEY RET$
  545.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  546.         SETVIEW 0, 0, GETMAXX, GETMAXY
  547.         EXIT SUB
  548.     END IF
  549.     FOR I = 0 TO 240
  550.         PALROTATE PAL(0), 16, 255, 2
  551.         PALGET PAL(0), 16, 255
  552.     NEXT I
  553.     FOR I = 0 TO 120
  554.         PALROTATE PAL(0), 16, 255, -8
  555.         PALGET PAL(0), 16, 255
  556.     NEXT I
  557.     GETKEY RET$
  558.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  559.         SETVIEW 0, 0, GETMAXX, GETMAXY
  560.         EXIT SUB
  561.     END IF
  562.     END SUB
  563.  
  564.     SUB DOPRIMS (RET$)
  565.     
  566.     '*************************************************************************
  567.     '* SET UP THE TITLE
  568.     '*************************************************************************
  569.     TITLE$ = "DEMO 1: Primitives"
  570.     PALSET PAL(0), 0, 255
  571.  
  572.     DIM P1 AS P2DType
  573.     DIM OFF1 AS P2DType
  574.     DIM OFF2 AS P2DType
  575.     DIM P2 AS P2DType
  576.      
  577.     '*************************************************************************
  578.     '* DRAW SOME POINTS
  579.     '*************************************************************************
  580.     FILLSCREEN 0
  581.     SETVIEW 0, 0, GETMAXX, GETMAXY
  582.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  583.     A$ = "DRWPOINT (Mode,Color,X1,Y1,X2,Y2)"
  584.     DRWSTRING 1, 7, 0, A$, 10, 18
  585.     SETVIEW 0, 32, GETMAXX, GETMAXY
  586.     Colr = 1
  587.     NUMOF = GETMAXX * 2
  588.     FOR A = 0 TO NUMOF
  589.         X1 = RND * GETMAXX
  590.         Y1 = RND * GETMAXY
  591.         DRWPOINT 1, Colr, X1, Y1
  592.         Colr = Colr + 1
  593.         IF Colr > 15 THEN
  594.             Colr = 1
  595.         END IF
  596.     NEXT A
  597.     GETKEY RET$
  598.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  599.         SETVIEW 0, 0, GETMAXX, GETMAXY
  600.         EXIT SUB
  601.     END IF
  602.  
  603.     '*************************************************************************
  604.     '* DRAW SOME LINES
  605.     '*************************************************************************
  606.     SETVIEW 0, 0, GETMAXX, GETMAXY
  607.     FILLSCREEN 0
  608.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  609.     A$ = "DRWLINE (Mode,Color,X1,Y1,X2,Y2)"
  610.     DRWSTRING 1, 7, 0, A$, 10, 18
  611.     SETVIEW 0, 32, GETMAXX, GETMAXY
  612.     NUMOF = GETMAXX \ 6
  613.     FOR A = 0 TO NUMOF
  614.         X1 = RND * GETMAXX
  615.         Y1 = RND * GETMAXY
  616.         X2 = RND * GETMAXX
  617.         Y2 = RND * GETMAXY
  618.         DRWLINE 1, Colr, X1, Y1, X2, Y2
  619.         Colr = Colr + 1
  620.         IF Colr > 15 THEN
  621.             Colr = 1
  622.         END IF
  623.     NEXT A
  624.     GETKEY RET$
  625.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  626.         SETVIEW 0, 0, GETMAXX, GETMAXY
  627.         EXIT SUB
  628.     END IF
  629.  
  630.     '*************************************************************************
  631.     '* DRAW SOME ANTIALIASED LINES
  632.     '*************************************************************************
  633.     SETVIEW 0, 0, GETMAXX, GETMAXY
  634.     FILLSCREEN 0
  635.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  636.     A$ = "DRWALINE (IntsBits,Color,X1,Y1,X2,Y2)  [antialiased lines]"
  637.     DRWSTRING 1, 7, 0, A$, 10, 18
  638.     SETVIEW 0, 32, GETMAXX, GETMAXY
  639.     NUMOF = GETMAXX \ 8
  640.     '* SET UP THE PALETTE..WE USE PCXPAL AS A TEMPORARY PALETTE
  641.     INTSBITS = 2
  642.     NUMLEVELS = 2 ^ INTSBITS
  643.     PALGET PCXPAL(0), 0, 255
  644.     FOR I = 0 TO NUMLEVELS - 1
  645.         '* BLUE
  646.         OFST = 128 + NUMLEVELS * 0 + I
  647.         PCXPAL(OFST).R = 0
  648.         PCXPAL(OFST).G = 0
  649.         PCXPAL(OFST).B = 63 - 35 * I / (NUMLEVELS - 1)
  650.  
  651.         '* GREEN
  652.         OFST = 128 + NUMLEVELS * 1 + I
  653.         PCXPAL(OFST).R = 0
  654.         PCXPAL(OFST).G = 63 - 35 * I / (NUMLEVELS - 1)
  655.         PCXPAL(OFST).B = 0
  656.      
  657.         '* CYAN
  658.         OFST = 128 + NUMLEVELS * 2 + I
  659.         PCXPAL(OFST).R = 0
  660.         PCXPAL(OFST).G = 63 - 35 * I / (NUMLEVELS - 1)
  661.         PCXPAL(OFST).B = 63 - 35 * I / (NUMLEVELS - 1)
  662.  
  663.         '* RED
  664.         OFST = 128 + NUMLEVELS * 3 + I
  665.         PCXPAL(OFST).R = 63 - 35 * I / (NUMLEVELS - 1)
  666.         PCXPAL(OFST).G = 0
  667.         PCXPAL(OFST).B = 0
  668.  
  669.         '* MAGENTA
  670.         OFST = 128 + NUMLEVELS * 4 + I
  671.         PCXPAL(OFST).R = 63 - 35 * I / (NUMLEVELS - 1)
  672.         PCXPAL(OFST).G = 0
  673.         PCXPAL(OFST).B = 63 - 35 * I / (NUMLEVELS - 1)
  674.  
  675.         '* YELLOW
  676.         OFST = 128 + NUMLEVELS * 5 + I
  677.         PCXPAL(OFST).R = 63 - 35 * I / (NUMLEVELS - 1)
  678.         PCXPAL(OFST).G = 63 - 35 * I / (NUMLEVELS - 1)
  679.         PCXPAL(OFST).B = 0
  680.  
  681.         '* WHITE
  682.         OFST = 128 + NUMLEVELS * 6 + I
  683.         PCXPAL(OFST).R = 63 - 35 * I / (NUMLEVELS - 1)
  684.         PCXPAL(OFST).G = 63 - 35 * I / (NUMLEVELS - 1)
  685.         PCXPAL(OFST).B = 63 - 35 * I / (NUMLEVELS - 1)
  686.     NEXT I
  687.     PALSET PCXPAL(0), 0, 255
  688.  
  689.     Colr = 0
  690.     FOR A = 0 TO NUMOF
  691.         X1 = RND * GETMAXX
  692.         Y1 = RND * GETMAXY
  693.         X2 = RND * GETMAXX
  694.         Y2 = RND * GETMAXY
  695.         DRWALINE INTSBITS, 128 + Colr * NUMLEVELS, X1, Y1, X2, Y2
  696.         Colr = Colr + 1
  697.         IF Colr > 6 THEN
  698.             Colr = 0
  699.         END IF
  700.     NEXT A
  701.     GETKEY RET$
  702.     PALSET ORGPAL(0), 0, 255
  703.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  704.         SETVIEW 0, 0, GETMAXX, GETMAXY
  705.         EXIT SUB
  706.     END IF
  707.  
  708.     '*************************************************************************
  709.     '* DRAW SOME BOXES
  710.     '*************************************************************************
  711.     SETVIEW 0, 0, GETMAXX, GETMAXY
  712.     FILLSCREEN 0
  713.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  714.     A$ = "DRWBOX (Mode,Color,X1,Y1,X2,Y2)"
  715.     DRWSTRING 1, 7, 0, A$, 10, 18
  716.     SETVIEW 0, 32, GETMAXX, GETMAXY
  717.     NUMOF = GETMAXX \ 10
  718.     FOR A = 0 TO NUMOF
  719.         X1 = RND * GETMAXX
  720.         Y1 = RND * GETMAXY
  721.         X2 = RND * GETMAXX
  722.         Y2 = RND * GETMAXY
  723.         DRWBOX 1, Colr, X1, Y1, X2, Y2
  724.         Colr = Colr + 1
  725.         IF Colr > 15 THEN
  726.             Colr = 1
  727.         END IF
  728.     NEXT A
  729.     GETKEY RET$
  730.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  731.         SETVIEW 0, 0, GETMAXX, GETMAXY
  732.         EXIT SUB
  733.     END IF
  734.  
  735.     '*************************************************************************
  736.     '* DRAW SOME FILLED BOXES
  737.     '*************************************************************************
  738.     SETVIEW 0, 0, GETMAXX, GETMAXY
  739.     FILLSCREEN 0
  740.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  741.     A$ = "DRWFILLBOX (Mode,Color,X1,Y1,X2,Y2)"
  742.     DRWSTRING 1, 7, 0, A$, 10, 18
  743.     SETVIEW 0, 32, GETMAXX, GETMAXY
  744.     NUMOF = GETMAXX \ 15
  745.     FOR A = 0 TO NUMOF
  746.         X1 = RND * GETMAXX
  747.         Y1 = RND * GETMAXY
  748.         X2 = RND * GETMAXX
  749.         Y2 = RND * GETMAXY
  750.         DRWFILLBOX 1, Colr, X1, Y1, X2, Y2
  751.         Colr = Colr + 1
  752.         IF Colr > 15 THEN
  753.             Colr = 1
  754.         END IF
  755.     NEXT A
  756.     GETKEY RET$
  757.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  758.         SETVIEW 0, 0, GETMAXX, GETMAXY
  759.         EXIT SUB
  760.     END IF
  761.  
  762.     '*************************************************************************
  763.     '* DRAW SOME CIRCLES
  764.     '*************************************************************************
  765.     SETVIEW 0, 0, GETMAXX, GETMAXY
  766.     FILLSCREEN 0
  767.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  768.     A$ = "DRWCIRCLE (Mode,Color,Cx,Cy,Radius)"
  769.     DRWSTRING 1, 7, 0, A$, 10, 18
  770.     SETVIEW 0, 32, GETMAXX, GETMAXY
  771.     NUMOF = GETMAXX \ 20
  772.     MAXRAD = GETMAXX \ 2
  773.     FOR A = 0 TO NUMOF
  774.         X = RND * GETMAXX
  775.         Y = RND * GETMAXY
  776.         RAD = RND * MAXRAD
  777.         DRWCIRCLE 1, Colr, X, Y, RAD
  778.         Colr = Colr + 1
  779.         IF Colr > 15 THEN
  780.             Colr = 1
  781.         END IF
  782.     NEXT A
  783.     GETKEY RET$
  784.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  785.         SETVIEW 0, 0, GETMAXX, GETMAXY
  786.         EXIT SUB
  787.     END IF
  788.     
  789.     '*************************************************************************
  790.     '* DRAW SOME FILLED CIRCLES
  791.     '*************************************************************************
  792.     SETVIEW 0, 0, GETMAXX, GETMAXY
  793.     FILLSCREEN 0
  794.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  795.     A$ = "DRWFILLCIRCLE (Mode,Color,Cx,Cy,Radius)"
  796.     DRWSTRING 1, 7, 0, A$, 10, 18
  797.     SETVIEW 0, 32, GETMAXX, GETMAXY
  798.     NUMOF = GETMAXX \ 25
  799.     MAXRAD = GETMAXX \ 2
  800.     FOR A = 0 TO NUMOF
  801.         X = RND * GETMAXX
  802.         Y = RND * GETMAXY
  803.         RAD = RND * MAXRAD
  804.         DRWFILLCIRCLE 1, Colr, X, Y, RAD
  805.         Colr = Colr + 1
  806.         IF Colr > 15 THEN
  807.             Colr = 1
  808.         END IF
  809.     NEXT A
  810.     GETKEY RET$
  811.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  812.         SETVIEW 0, 0, GETMAXX, GETMAXY
  813.         EXIT SUB
  814.     END IF
  815.  
  816.     '*************************************************************************
  817.     '* DRAW SOME ELLIPSES
  818.     '*************************************************************************
  819.     SETVIEW 0, 0, GETMAXX, GETMAXY
  820.     FILLSCREEN 0
  821.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  822.     A$ = "DRWELLIPSE (Mode,Color,Cx,Cy,RadiusX,RadiusY)"
  823.     DRWSTRING 1, 7, 0, A$, 10, 18
  824.     SETVIEW 0, 32, GETMAXX, GETMAXY
  825.     NUMOF = GETMAXX \ 20
  826.     MAXRAD = GETMAXX \ 2
  827.     FOR A = 0 TO NUMOF
  828.         X = RND * GETMAXX
  829.         Y = RND * GETMAXY + 35
  830.         RADX = RND * MAXRAD
  831.         RADY = RND * MAXRAD
  832.         DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  833.         Colr = Colr + 1
  834.         IF Colr > 15 THEN
  835.             Colr = 1
  836.         END IF
  837.     NEXT A
  838.     SETVIEW 0, 0, GETMAXX, GETMAXY
  839.     GETKEY RET$
  840.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  841.         EXIT SUB
  842.     END IF
  843.  
  844.     '*************************************************************************
  845.     '* DRAW SOME FILLED ELLIPSES
  846.     '*************************************************************************
  847.     SETVIEW 0, 0, GETMAXX, GETMAXY
  848.     FILLSCREEN 0
  849.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  850.     A$ = "DRWFILLELLIPSE (Mode,Color,Cx,Cy,RadiusX,RadiusY)"
  851.     DRWSTRING 1, 7, 0, A$, 10, 18
  852.     SETVIEW 0, 32, GETMAXX, GETMAXY
  853.     NUMOF = GETMAXX \ 25
  854.     MAXRAD = GETMAXX \ 2
  855.     FOR A = 0 TO NUMOF
  856.         X = RND * GETMAXX
  857.         Y = RND * GETMAXY + 35
  858.         RADX = RND * MAXRAD
  859.         RADY = RND * MAXRAD
  860.         DRWFILLELLIPSE 1, Colr, X, Y, RADX, RADY
  861.         Colr = Colr + 1
  862.         IF Colr > 15 THEN
  863.             Colr = 1
  864.         END IF
  865.     NEXT A
  866.     SETVIEW 0, 0, GETMAXX, GETMAXY
  867.     GETKEY RET$
  868.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  869.         EXIT SUB
  870.     END IF
  871.  
  872.     '*************************************************************************
  873.     '* DRAW SOME CIRCLULAR ARCS
  874.     '*************************************************************************
  875.     SETVIEW 0, 0, GETMAXX, GETMAXY
  876.     FILLSCREEN 0
  877.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  878.     A$ = "DRWCIRARC (Mode,Color,Cx,Cy,Radius,StartAng,EndAng)"
  879.     DRWSTRING 1, 7, 0, A$, 10, 18
  880.     SETVIEW 0, 32, GETMAXX, GETMAXY
  881.     NUMOF = GETMAXX \ 20
  882.     MAXRAD = GETMAXX \ 2
  883.     FOR A = 0 TO NUMOF
  884.         X = RND * GETMAXX
  885.         Y = RND * GETMAXY
  886.         RAD = RND * MAXRAD
  887.         SANG = RND * 360
  888.         EANG = RND * 360 + SANG
  889.         DRWCIRARC 1, Colr, X, Y, RAD, SANG, EANG
  890.         Colr = Colr + 1
  891.         IF Colr > 15 THEN
  892.             Colr = 1
  893.         END IF
  894.     NEXT A
  895.     GETKEY RET$
  896.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  897.         SETVIEW 0, 0, GETMAXX, GETMAXY
  898.         EXIT SUB
  899.     END IF
  900.  
  901.     '*************************************************************************
  902.     '* DRAW SOME ELLIPTICAL ARCS
  903.     '*************************************************************************
  904.     SETVIEW 0, 0, GETMAXX, GETMAXY
  905.     FILLSCREEN 0
  906.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  907.     A$ = "DRWELLARC (Mode,Color,Cx,Cy,RadiusX,RadiusY,StartAng,EndAng)"
  908.     DRWSTRING 1, 7, 0, A$, 10, 18
  909.     SETVIEW 0, 32, GETMAXX, GETMAXY
  910.     NUMOF = GETMAXX \ 20
  911.     MAXRAD = GETMAXX \ 2
  912.     FOR A = 0 TO NUMOF
  913.         X = RND * GETMAXX
  914.         Y = RND * GETMAXY + 35
  915.         RADX = RND * MAXRAD
  916.         RADY = RND * MAXRAD
  917.         SANG = RND * 360
  918.         EANG = RND * 360 + SANG
  919.         DRWELLARC 1, Colr, X, Y, RADX, RADY, SANG, EANG
  920.         Colr = Colr + 1
  921.         IF Colr > 15 THEN
  922.             Colr = 1
  923.         END IF
  924.     NEXT A
  925.     SETVIEW 0, 0, GETMAXX, GETMAXY
  926.     GETKEY RET$
  927.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  928.         EXIT SUB
  929.     END IF
  930.  
  931.     '*************************************************************************
  932.     '* DRAW SOME CUBIC BEZIER CURVES
  933.     '*************************************************************************
  934.     SETVIEW 0, 0, GETMAXX, GETMAXY
  935.     FILLSCREEN 0
  936.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  937.     A$ = "DRWCUBICBEZIER (Mode,Color,Pon1,Poff1,Poff2,Pon2)"
  938.     DRWSTRING 1, 7, 0, A$, 10, 18
  939.     SETVIEW 0, 32, GETMAXX, GETMAXY
  940.     NUMOF = GETMAXX \ 20
  941.     FOR A = 0 TO NUMOF
  942.         P1.X = RND * GETMAXX
  943.         P1.Y = RND * GETMAXY
  944.         OFF1.X = RND * GETMAXX
  945.         OFF1.Y = RND * GETMAXY
  946.         OFF2.X = RND * GETMAXX
  947.         OFF2.Y = RND * GETMAXY
  948.         P2.X = RND * GETMAXX
  949.         P2.Y = RND * GETMAXY
  950.         DRWCUBICBEZIER 1, Colr, P1.X, OFF1.X, OFF2.X, P2.X
  951.         Colr = Colr + 1
  952.         IF Colr > 15 THEN
  953.             Colr = 1
  954.         END IF
  955.     NEXT A
  956.     GETKEY RET$
  957.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  958.         SETVIEW 0, 0, GETMAXX, GETMAXY
  959.         EXIT SUB
  960.     END IF
  961.     
  962.  
  963.     END SUB
  964.  
  965.     SUB DOSCROLL (RET$)
  966.     
  967.     '*************************************************************************
  968.     '* SET UP THE TITLE
  969.     '*************************************************************************
  970.     TITLE$ = "DEMO 7: Scrolling and Paging Functions"
  971.     PALSET PAL(0), 0, 255
  972.     FILLSCREEN 0
  973.     SETVIEW 0, 0, GETMAXX, GETMAXY
  974.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  975.  
  976.     SPCNG = (GETMAXY - 32) \ 5
  977.     X1 = ((GETMAXX + 1) \ 2) - SPCNG
  978.     Y1 = (((GETMAXY + 1 - 32) \ 2) + 32) - SPCNG
  979.     X2 = ((GETMAXX + 1) \ 2) + SPCNG
  980.     Y2 = (((GETMAXY + 1 - 32) \ 2) + 32) + SPCNG
  981.     SKIP = SPCNG / 15
  982.     NUM = SPCNG / SKIP
  983.     DRWBOX 1, 12, X1, Y1, X2, Y2
  984.     X1 = X1 + 1
  985.     Y1 = Y1 + 1
  986.     X2 = X2 - 1
  987.     Y2 = Y2 - 1
  988.     Colr = 16
  989.     TEXT$ = "TEXT text TEXT text TEXT"
  990.  
  991.     '*************************************************************************
  992.     '* SHOW SCROLLUP
  993.     '*************************************************************************
  994.     SETVIEW 0, 0, GETMAXX, GETMAXY
  995.     A$ = "SCROLLUP (X1,Y1,X2,Y2,NumLines,FillColr)"
  996.     DRWSTRING 1, 7, 0, A$, 10, 16
  997.     SETVIEW X1, Y1, X2, Y2
  998.     FILLVIEW 0
  999.     NUMOF = GETMAXX \ 10
  1000.     FOR A = 0 TO NUMOF
  1001.         X = RND * GETMAXX
  1002.         Y = RND * GETMAXY
  1003.         I = RND * GETMAXX
  1004.         J = RND * GETMAXY
  1005.         DRWLINE 1, Colr, X, Y, I, J
  1006.         Colr = Colr + 3
  1007.         IF Colr > 255 THEN
  1008.             Colr = 16
  1009.         END IF
  1010.     NEXT A
  1011.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1012.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1013.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1014.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1015.     FOR A = 0 TO NUM
  1016.         SCROLLUP X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  1017.     NEXT A
  1018.     GETKEY RET$
  1019.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1020.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1021.         EXIT SUB
  1022.     END IF
  1023.  
  1024.     '*************************************************************************
  1025.     '* SHOW SCROLLLT
  1026.     '*************************************************************************
  1027.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1028.     A$ = "SCROLLLT (X1,Y1,X2,Y2,NumLines,FillColr)"
  1029.     DRWSTRING 1, 7, 0, A$, 10, 16
  1030.     SETVIEW X1, Y1, X2, Y2
  1031.     FILLVIEW 0
  1032.     NUMOF = GETMAXX \ 10
  1033.     FOR A = 0 TO NUMOF
  1034.         X = RND * GETMAXX
  1035.         Y = RND * GETMAXY
  1036.         I = RND * GETMAXX
  1037.         J = RND * GETMAXY
  1038.         DRWLINE 1, Colr, X, Y, I, J
  1039.         Colr = Colr + 3
  1040.         IF Colr > 255 THEN
  1041.             Colr = 16
  1042.         END IF
  1043.     NEXT A
  1044.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1045.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1046.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1047.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1048.     FOR A = 0 TO NUM
  1049.         SCROLLLT X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  1050.     NEXT A
  1051.     GETKEY RET$
  1052.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1053.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1054.         EXIT SUB
  1055.     END IF
  1056.  
  1057.     '*************************************************************************
  1058.     '* SHOW SCROLLDN
  1059.     '*************************************************************************
  1060.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1061.     A$ = "SCROLLDN (X1,Y1,X2,Y2,NumLines,FillColr)"
  1062.     DRWSTRING 1, 7, 0, A$, 10, 16
  1063.     SETVIEW X1, Y1, X2, Y2
  1064.     FILLVIEW 0
  1065.     NUMOF = GETMAXX \ 10
  1066.     FOR A = 0 TO NUMOF
  1067.         X = RND * GETMAXX
  1068.         Y = RND * GETMAXY
  1069.         I = RND * GETMAXX
  1070.         J = RND * GETMAXY
  1071.         DRWLINE 1, Colr, X, Y, I, J
  1072.         Colr = Colr + 3
  1073.         IF Colr > 255 THEN
  1074.             Colr = 16
  1075.         END IF
  1076.     NEXT A
  1077.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1078.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1079.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1080.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1081.     FOR A = 0 TO NUM
  1082.         SCROLLDN X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  1083.     NEXT A
  1084.     GETKEY RET$
  1085.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1086.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1087.         EXIT SUB
  1088.     END IF
  1089.  
  1090.     '*************************************************************************
  1091.     '* SHOW SCROLLRT
  1092.     '*************************************************************************
  1093.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1094.     A$ = "SCROLLRT (X1,Y1,X2,Y2,NumLines,FillColr)"
  1095.     DRWSTRING 1, 7, 0, A$, 10, 16
  1096.     SETVIEW X1, Y1, X2, Y2
  1097.     FILLVIEW 0
  1098.     NUMOF = GETMAXX \ 10
  1099.     FOR A = 0 TO NUMOF
  1100.         X = RND * GETMAXX
  1101.         Y = RND * GETMAXY
  1102.         I = RND * GETMAXX
  1103.         J = RND * GETMAXY
  1104.         DRWLINE 1, Colr, X, Y, I, J
  1105.         Colr = Colr + 3
  1106.         IF Colr > 255 THEN
  1107.             Colr = 16
  1108.         END IF
  1109.     NEXT A
  1110.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1111.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1112.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1113.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  1114.     FOR A = 0 TO NUM
  1115.         SCROLLRT X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  1116.     NEXT A
  1117.     GETKEY RET$
  1118.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1119.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1120.         EXIT SUB
  1121.     END IF
  1122.  
  1123.     '*************************************************************************
  1124.     '* SHOW PAGING
  1125.     '*************************************************************************
  1126.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1127.  
  1128.     '*************************************************************************
  1129.     '* CHECK TO SEE IF CARD SUPPORTS CHANGING THE DISPLAY OFFSET
  1130.     '*************************************************************************
  1131.     X1 = GETMAXX + 1
  1132.     Y1 = GETMAXY + 1
  1133.     IF PAGEDISPLAY(0, 0, 0) = 0 THEN
  1134.         FILLSCREEN 0
  1135.         SOUND 100, 5
  1136.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  1137.         A$ = "Sorry, This Video Card Does Not Support"
  1138.         DRWSTRING 1, 7, 0, A$, 10, 16
  1139.         A$ = "Changing The Display Offset In This"
  1140.         DRWSTRING 1, 7, 0, A$, 10, 32
  1141.         A$ = "Video Mode...Can Not Do The Paging Demo."
  1142.         DRWSTRING 1, 7, 0, A$, 10, 48
  1143.         A$ = "Press A Key..."
  1144.         DRWSTRING 1, 15, 0, A$, 10, 64
  1145.         WHILE INKEY$ = ""
  1146.         WEND
  1147.         FILLSCREEN 0
  1148.         EXIT SUB
  1149.     END IF
  1150.  
  1151.     
  1152.     '*************************************************************************
  1153.     '* CHECK TO SEE IF THERE IS ENOUGH MEMORY FOR MULTIPLE PAGES
  1154.     '*************************************************************************
  1155.     NUMBANKS = WHICHMEM / 64
  1156.     XSIZE& = GETMAXX + 1
  1157.     YSIZE& = GETMAXY + 1
  1158.     BANKSPERPAGE& = XSIZE& * YSIZE& / 65536
  1159.     NUMPAGES = INT((NUMBANKS / BANKSPERPAGE&) - 1)
  1160.  
  1161.     '* LIMIT THE TOTAL NUMBER OF PAGES TO 3 (0-2) FOR THIS DEMO
  1162.     IF NUMPAGES > 2 THEN
  1163.         NUMPAGES = 2
  1164.     END IF
  1165.  
  1166.     IF NUMPAGES = 0 THEN
  1167.         FILLSCREEN 0
  1168.         SOUND 100, 5
  1169.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  1170.         A$ = "Sorry, This Video Card Does Not Have Enough Video"
  1171.         DRWSTRING 1, 7, 0, A$, 10, 16
  1172.         A$ = "Memory To Support Multiple Video Pages In This Mode."
  1173.         DRWSTRING 1, 7, 0, A$, 10, 32
  1174.         A$ = "Press A Key..."
  1175.         DRWSTRING 1, 15, 0, A$, 10, 48
  1176.         WHILE INKEY$ = ""
  1177.         WEND
  1178.         FILLSCREEN 0
  1179.         EXIT SUB
  1180.     END IF
  1181.     NUMOF = GETMAXX \ 6
  1182.     FILLSCREEN 0
  1183.     FOR PAGE = 0 TO NUMPAGES
  1184.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1185.         DUMMY = PAGEACTIVE(PAGE)
  1186.         DUMMY = PAGEDISPLAY(0, 0, PAGE)
  1187.         FILLPAGE 0
  1188.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  1189.         A$ = "PAGEACTIVE(Page)"
  1190.         DRWSTRING 1, 7, 0, A$, 10, 16
  1191.         A$ = "PAGEDISPLAY(StartX,StartY,Page)"
  1192.         DRWSTRING 1, 7, 0, A$, 10, 32
  1193.         DRWBOX 1, 15, 0, 48, GETMAXX, GETMAXY
  1194.         A$ = "THIS IS PAGE" + STR$(PAGE)
  1195.         FOR I = 0 TO 20
  1196.             DRWSTRING 1, 12 + PAGE, 0, A$, 10, 50 + I * 16
  1197.         NEXT I
  1198.         SETVIEW 150, 58, GETMAXX - 10, GETMAXY - 10
  1199.         FOR I = 0 TO NUMOF
  1200.             X1 = RND * GETMAXX
  1201.             Y1 = RND * GETMAXY
  1202.             X2 = RND * 100
  1203.             Y2 = RND * 100
  1204.             C = RND * 15
  1205.             SELECT CASE PAGE
  1206.                 CASE = 0
  1207.                     DRWFILLCIRCLE 1, C, X1, Y1, X2
  1208.                 CASE = 1
  1209.                     DRWLINE 1, C, X1, Y1, X1 + X2, Y1 + Y2
  1210.                     DRWELLIPSE 1, C + 1, X1, Y1, X2 / 4, Y2 / 4
  1211.                 CASE = 2
  1212.                     DRWFILLBOX 1, C, X1, Y1, X1 + X2, Y1 + Y2
  1213.             END SELECT
  1214.         NEXT I
  1215.         DRWBOX 1, 15, 150, 58, GETMAXX - 10, GETMAXY - 10
  1216.         SDELAY 35
  1217.     NEXT PAGE
  1218.     DUMMY = PAGEACTIVE(0)
  1219.     DUMMY = PAGEDISPLAY(0, 0, 0)
  1220.  
  1221.     GETKEY RET$
  1222.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1223.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1224.         EXIT SUB
  1225.     END IF
  1226.  
  1227.     FOR I = 0 TO 1
  1228.         FOR PAGE = 0 TO NUMPAGES
  1229.             DUMMY = PAGEDISPLAY(0, 0, PAGE)
  1230.             SDELAY 35
  1231.         NEXT PAGE
  1232.     NEXT I
  1233.     FOR I = 0 TO 20
  1234.         FOR PAGE = 0 TO NUMPAGES
  1235.             DUMMY = PAGEDISPLAY(0, 0, PAGE)
  1236.             SDELAY 1
  1237.         NEXT PAGE
  1238.     NEXT I
  1239.     DUMMY = PAGEDISPLAY(0, 0, 0)
  1240.  
  1241.     GETKEY RET$
  1242.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1243.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1244.         EXIT SUB
  1245.     END IF
  1246.  
  1247.  
  1248.     END SUB
  1249.  
  1250.     SUB DOTEXT (RET$)
  1251.     
  1252.     '*************************************************************************
  1253.     '* SET UP THE TITLE
  1254.     '*************************************************************************
  1255.     TITLE$ = "DEMO 6: Text functions"
  1256.     PALSET PAL(0), 0, 255
  1257.  
  1258.     '*************************************************************************
  1259.     '* SHOW ALTERNATE PRINT DIRECTIONS
  1260.     '*************************************************************************
  1261.  
  1262.     FILLSCREEN 0
  1263.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1264.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  1265.     A$ = "DRWSTRING(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  1266.     DRWSTRING 1, 7, 0, A$, 10, 16
  1267.     SETVIEW 0, 32, GETMAXX, GETMAXY
  1268.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  1269.     Colr = 16
  1270.     FOR Y = 32 TO GETMAXY STEP 20
  1271.         DRWSTRING 1, Colr, 0, A$, 0, Y
  1272.         Colr = Colr + 5
  1273.         IF Colr > 255 THEN
  1274.             Colr = 16
  1275.         END IF
  1276.     NEXT Y
  1277.     GETKEY RET$
  1278.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1279.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1280.         FILLSCREEN 0
  1281.         EXIT SUB
  1282.     END IF
  1283.  
  1284.     FILLVIEW 0
  1285.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1286.     A$ = "DRWSTRINGLT(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  1287.     DRWSTRING 1, 7, 0, A$, 10, 16
  1288.     SETVIEW 0, 32, GETMAXX, GETMAXY
  1289.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  1290.     FOR X = 0 TO GETMAXX STEP 20
  1291.         DRWSTRINGLT 1, Colr, 0, A$, X, GETMAXY
  1292.         Colr = Colr + 5
  1293.         IF Colr > 255 THEN
  1294.             Colr = 16
  1295.         END IF
  1296.     NEXT X
  1297.     GETKEY RET$
  1298.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1299.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1300.         FILLSCREEN 0
  1301.         EXIT SUB
  1302.     END IF
  1303.  
  1304.     FILLVIEW 0
  1305.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1306.     A$ = "DRWSTRINGDN(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  1307.     DRWSTRING 1, 7, 0, A$, 10, 16
  1308.     SETVIEW 0, 32, GETMAXX, GETMAXY
  1309.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  1310.     Colr = 16
  1311.     FOR Y = GETMAXY TO 32 STEP -20
  1312.         DRWSTRINGDN 1, Colr, 0, A$, GETMAXX, Y
  1313.         Colr = Colr + 5
  1314.         IF Colr > 255 THEN
  1315.             Colr = 16
  1316.         END IF
  1317.     NEXT Y
  1318.     GETKEY RET$
  1319.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1320.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1321.         FILLSCREEN 0
  1322.         EXIT SUB
  1323.     END IF
  1324.     FILLVIEW 0
  1325.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1326.     A$ = "DRWSTRINGRT(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  1327.     DRWSTRING 1, 7, 0, A$, 10, 16
  1328.     SETVIEW 0, 32, GETMAXX, GETMAXY
  1329.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  1330.     FOR X = GETMAXX TO 0 STEP -20
  1331.         DRWSTRINGRT 1, Colr, 0, A$, X, 32
  1332.         Colr = Colr + 5
  1333.         IF Colr > 255 THEN
  1334.             Colr = 16
  1335.         END IF
  1336.     NEXT X
  1337.     GETKEY RET$
  1338.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  1339.         SETVIEW 0, 0, GETMAXX, GETMAXY
  1340.         FILLSCREEN 0
  1341.         EXIT SUB
  1342.     END IF
  1343.     END SUB
  1344.  
  1345.